home *** CD-ROM | disk | FTP | other *** search
/ Collection of Tools & Utilities / Collection of Tools and Utilities.iso / edit / me_cd25.zip / MUTT2.ZIP / SPELL.MUT < prev    next >
Lisp/Scheme  |  1992-11-09  |  5KB  |  163 lines
  1. ;; Spelling correction interface for Emacs.
  2. ;; Copyright (C) 1985 Free Software Foundation, Inc.
  3.  
  4. ;; This file is part of GNU Emacs.
  5.  
  6. ;; GNU Emacs is distributed in the hope that it will be useful,
  7. ;; but WITHOUT ANY WARRANTY.  No author or distributor
  8. ;; accepts responsibility to anyone for the consequences of using it
  9. ;; or for whether it serves any particular purpose or works at all,
  10. ;; unless he says so in writing.  Refer to the GNU Emacs General Public
  11. ;; License for full details.
  12.  
  13. ;; Everyone is granted permission to copy, modify and redistribute
  14. ;; GNU Emacs, but only under the conditions described in the
  15. ;; GNU Emacs General Public License.   A copy of this license is
  16. ;; supposed to have been given to you along with GNU Emacs so you
  17. ;; can know your rights and responsibilities.  It should be in a
  18. ;; file named COPYING.  Among other things, the copyright notice
  19. ;; and this notice must be preserved on all copies.
  20.  
  21. ;; Ported to Mutt2 4/92 C Durland
  22.  
  23. ;; Check spelling of every word in the buffer.
  24. ;; For each incorrect word, you are asked for the correct spelling and then
  25. ;; put into a query-replace to fix some or all occurrences.  If you do not
  26. ;; want to change a word, just give the same word as its "correct"
  27. ;; spelling; then the query replace is skipped.
  28.  
  29. (include me2.h)
  30.  
  31. (defun spell-region
  32. {
  33.   (int point)
  34.  
  35.   (point (create-mark))
  36.   (set-mark point)
  37.  
  38.   (spell-check-region THE-DOT THE-MARK "region")
  39.  
  40.   (goto-mark point)
  41. })
  42.  
  43. (defun spell-buffer
  44. {
  45.   (int mark1 mark2 point bag)
  46.  
  47.   (point (create-mark))(mark1 (create-mark))(mark2 (create-mark))
  48.   (set-mark point)
  49.  
  50.   (beginning-of-buffer)(set-mark mark1)
  51.   (end-of-buffer)      (set-mark mark2)
  52.   (spell-check-region mark1 mark2 "buffer")
  53.  
  54.   (goto-mark point)
  55. })
  56.  
  57. ;; Check spelling of word at or before point.
  58. ;; If it is not correct, ask user for the correct spelling and
  59. ;;   query-replace the entire buffer to substitute it.
  60. (defun spell-word
  61. {
  62.   (int mark1 mark2 point bag)
  63.  
  64.   (point (create-mark))(mark1 (create-mark))(mark2 (create-mark))
  65.   (bag (create-bag))
  66.  
  67.   (set-mark point)
  68.  
  69. ;  (if (not (looking-at '\<')) (previous-word))
  70.   (if (!= 1 (current-column))    ;; !!! bug work around
  71.     {
  72.       (previous-character)
  73.       (if (not (looking-at '.\<'))
  74.         { (next-character)(previous-word) }
  75.     (next-character))
  76.     })
  77.  
  78.   (set-mark mark1)
  79.   (next-word)(set-mark mark2)
  80.  
  81.   (append-to-bag bag APPEND-REGION mark1 mark2)
  82.   (spell-check-region mark1 mark2 (concat "\"" (bag-to-string bag) "\""))
  83.  
  84.   (goto-mark point)
  85. })
  86.  
  87. ;; Like spell-buffer but applies only to region.
  88. ;; From program, applies from START to END.
  89. ;; Notes:
  90. ;;   Spell is case sensitive.  The same (misspelled) word with different
  91. ;;     case will be rejected twice.
  92. ;; !!! need case matching qr
  93. (defun spell-check-region (int mark1 mark2) (string description) HIDDEN
  94. {
  95.   (int buffer curbuf bag case-fold-state)
  96.   (string word newword)
  97.  
  98.   (msg "Checking spelling of " description  "...")
  99.  
  100.   (case-fold-state (case-fold-search))(case-fold-search 0)
  101.   (curbuf (current-buffer))
  102.  
  103.   (bag (create-bag))
  104.   (buffer (create-buffer "*temp*"))
  105.  
  106.   (append-to-bag bag APPEND-REGION mark1 mark2)
  107.   (append-to-bag bag APPEND-TEXT "^J")
  108.  
  109.   (current-buffer buffer)
  110.  
  111.   (OS-filter "spell" bag -1 TRUE)    ;; generate a list of bad words
  112.   (update)
  113.  
  114. (goto-line 1)
  115.   (msg "Checking spelling of " description "... "
  116.       (if (EoB) "correct" "not correct"))
  117.  
  118. ;      (case-fold-search t)
  119. ;      (case-replace t)
  120.  
  121.   (while (not (EoB))
  122.     {
  123.       (looking-at '.+')
  124.       (word (get-matched '&'))
  125.       (ask-user)(newword (ask "Replacement for " word ": "))
  126.       (if (== "-" newword) { (forward-line -1)(continue) })
  127.       (if (and (!= newword "") (!= word newword))
  128.         {
  129.       (current-buffer curbuf) (beginning-of-buffer)
  130.       (re-query-replace (concat '\<' word '\>') newword)
  131.  
  132.       (current-buffer buffer)
  133.     })
  134.       (forward-line 1)
  135.     })
  136.  
  137.   (current-buffer curbuf)
  138.   (case-fold-search case-fold-state)
  139. })
  140.  
  141. ;; Check spelling of string supplied as argument.
  142. (defun spell-string ; (string s)
  143. {
  144.   (int bag1 bag2)
  145.   (string s)
  146.  
  147.   (s (ask "Spell string: "))
  148.  
  149.   (bag1 (create-bag))
  150.   (bag2 (create-bag))
  151.  
  152.   (append-to-bag bag1 APPEND-TEXT s)
  153.   (append-to-bag bag1 APPEND-TEXT "^J")
  154.  
  155.   (OS-filter "spell" bag1 bag2)
  156.   (update)
  157.  
  158.   (msg "\"" s "\" is "
  159.     (if (== 0 (length-of (bag-to-string bag2))) "correct." "incorrect."))
  160.  
  161.   (free-bag bag1 bag2)
  162. })
  163.